home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / bled.arc / BLED.BAS next >
Encoding:
BASIC Source File  |  1986-04-13  |  24.4 KB  |  889 lines
  1. REM ****************************************************************
  2. REM *         NOTICE:  DO NOT REMOVE THIS NOTICE                   *
  3. REM *         BLED - (C) 1985,1986 by Ken Goosens                  *
  4. REM *       5020 Portsmouth Road, Fairfax, VA 22032                *
  5. REM ****************************************************************
  6. REM 8 April 1986 enhanced to add comments to bled merge
  7. REM 13 April 1986 fixed bug so could embed source code in comments
  8.  
  9. REM *******************   DRIVER MODULE   **************************
  10.  
  11. DEFINT A-Z
  12.  
  13. NCNFG = 12
  14. DIM CWRDS$(10),FROW(3),FCOL(3),FPROMPT$(3),FFLDSIZE(3),FFLDTYPE$(3),_
  15.     FFLDVAL$(3),FHLP$(3),CROW(NCNFG),CCOL(NCNFG),CPRO$(NCNFG),_
  16.     CFLDSIZE(NCNFG),CFLDTYPE$(NCNFG),CFLDVAL$(NCNFG),CHLP$(NCNFG)
  17.  
  18. GOSUB DOCMDLINE
  19. GOSUB SETCONSTANTS
  20. GOSUB GETCONFIG
  21. LBLK = LEN(ENDBLK$)
  22. TRANSBLK$ = SPACE$(LBLK)
  23. OPEN "O",#4,WARNFILE$
  24. MAXBTWLINES = VAL(MAXBTWLINES$)
  25. REDIM MBUF$(MAXBTWLINES),TBUF$(MAXBTWLINES)
  26. IF RUN.BATCH=0 THEN GOSUB ASKMERGE
  27.  
  28. WHILE ANS$ <> "Q"
  29.    X = INSTR(CMVAL$,ANS$)
  30.    IF X>1 THEN PRINT #4,"--[WARNINGS FOR FUNCTION ";ANS$;"]--
  31.    FILE.COMPARE = (ANS$ = "F")
  32.    ON INSTR (CMVAL$,ANS$) GOSUB SETCONFIG,FILECOMPARE,DOLINEMERGE,DOMERGE
  33.    COLOR 7,0
  34.    ANS$ = "Q"
  35.    IF RUN.BATCH=0 THEN GOSUB ASKMERGE
  36. WEND
  37. CLOSE #4
  38.       
  39. END
  40.  
  41. REM  *********************    GOSUBS    **************************
  42.  
  43. ASKMERGE:
  44.  
  45.    LOCATE CMRO,1
  46.    PRINT SPACE$(79)
  47.    CALL GETCHAR (CMRO,CMCO,CMPRO$,CMVAL$,ANS$)
  48.  
  49. RETURN
  50.  
  51. REM  ****              PREPATORY SUBROUTINES                  ****
  52. REM  **********  DOCMDLINE, SETCONSTANTS, GETCONFIG **************
  53.  
  54. REM -----------------------[ DOCMDLINE ]------------------------------------------------
  55.  
  56. DOCMDLINE:
  57.  
  58. REM PROCESSES COMMAND LINE ARGUMENTS FROM DOS
  59.  
  60.   RUN.BATCH  = INSTR(COMMAND$,"/B")
  61.   LINE.MERGE = INSTR(COMMAND$,"/L")
  62.   REG.MERGE  = INSTR(COMMAND$,"/M")
  63.   FILE.COMPARE = INSTR(COMMAND$,"/F")
  64.  
  65.   IF (LINE.MERGE OR REG.MERGE OR FILE.COMPARE)  THEN_
  66.   IF (LINE.MERGE AND REG.MERGE) OR (LINE.MERGE AND FILE.COMPARE) OR_
  67.      (REG.MERGE AND FILE.COMPARE) THEN_
  68.        X$="Can not use more than one of /F /L /M.":GOSUB DOABORT
  69.   IF REG.MERGE THEN ANS$="M" ELSE_
  70.      IF LINE.MERGE THEN ANS$="L" ELSE_
  71.      IF FILE.COMPARE THEN ANS$="F" ELSE ANS$=""
  72.   IF RUN.BATCH AND ANS$="" THEN_
  73.      X$="Must specify one of /F /L /M to run batch.":GOSUB DOABORT
  74.   CALL BRKWORDS (COMMAND$,CWRDS$())
  75.   NON.OPT = 1
  76.   WHILE INSTR(CWRDS$(NON.OPT),"/") > 0
  77.     NON.OPT = NON.OPT + 1
  78.   WEND
  79.   IF RUN.BATCH AND CWRDS$(NON.OPT+2)="" THEN_
  80.     X$="Must specify all three file arguments to run batch.":GOSUB DOABORT
  81.   IF COMMAND$="" THEN CALL CREDITS
  82.  
  83.   IF CWRDS$(NON.OPT+4)<>"" THEN_
  84.      CONFIGFILE$ = CWRDS$(NON.OPT+4)_
  85.   ELSE_
  86.      CONFIGFILE$ = "BLED.CFG"
  87.   IF CWRDS$(NON.OPT+3)<>"" THEN_
  88.      WARNFILE$ = CWRDS$(NON.OPT+3)_
  89.   ELSE_
  90.      WARNFILE$ = ""
  91.   IF CWRDS$(NON.OPT+2)<>"" THEN_
  92.      NEWFILE$=CWRDS$(NON.OPT+2) _
  93.   ELSE_
  94.      NEWFILE$="SC"
  95.   IF CWRDS$(NON.OPT+1)<>"" THEN_
  96.      BTCHCMDS$=CWRDS$(NON.OPT+1) _
  97.   ELSE_
  98.      BTCHCMDS$="SC"
  99.   IF CWRDS$(NON.OPT)<>"" THEN_
  100.      ORIGFILE$=CWRDS$(NON.OPT) _
  101.   ELSE_
  102.      ORIGFILE$="SC"
  103.  
  104.   LIMIT.RUN = INSTR(COMMAND$,"/T=")
  105.   IF LIMIT.RUN=0 THEN RETURN
  106.   LIMIT.RUN = LIMIT.RUN + 1
  107.   LAST.CHAR = INSTR(LIMIT.RUN,COMMAND$,"/")
  108.   IF LAST.CHAR=0 THEN LAST.CHAR = INSTR(LIMIT.RUN,COMMAND$," ")
  109.   IF LAST.CHAR=0 THEN LAST.CHAR = LEN(COMMAND$)+1
  110.   MAX.LL = VAL(MID$(COMMAND$,LIMIT.RUN+2,LAST.CHAR-LIMIT.RUN-2))
  111. REM  PRINT "MAX.LL=";MAX.LL;" GOT FROM ";COMMAND$;" starting at ";LIMIT.RUN+2;_
  112. REM    " and grabbing ";LAST.CHAR-LIMIT.RUN-2;" chars"
  113. REM   PRINT "Last char=";last.char: input xx$
  114. RETURN
  115.  
  116. DOABORT:
  117.  
  118. REM PREMATURELY TERMINATE WITH CENTERED ERROR MESSAGE AND HELP
  119.  
  120.   BEEP
  121.   X = LEN(X$)+17
  122.   IF X<78 THEN K = (78-X)/2 ELSE K=0
  123.   PRINT SPACE$(K);X$;"  Aborting."
  124.   CALL PRTHELP
  125.   END
  126.  
  127. RETURN
  128.  
  129. REM --------------------------[ SETCONSTANTS ]-----------------------------
  130.  
  131. SETCONSTANTS:
  132.  
  133. REM ASSIGNS CONSTANTS USED IN PROGRAM
  134.  
  135.   HI.VALUE# = 99999999
  136.   ONE = 1
  137.   TWO = 2
  138.   SEVENTYTWO = 72
  139.  
  140.   INSERTING$ = "* INSERTING new line(s)"
  141.   DELETING$ = "* DELETING old line(s)"
  142.   REPLACING$ = "* REPLACING old line(s) by new"
  143.   FIRSTDIF$ = "* ------[ first line different ]------"
  144.  
  145.   CMPRO$ = "C)onfigure, F)ile compare, L)ine# merge, M)erge, Q)uit (C,L,M,Q): "
  146.   CMRO = 21
  147.   CMCO = 5
  148.   CMVAL$ = "CFLMQ"
  149.  
  150.   EDPRO$ = "E)dit, R)un, Q)uit (E,R,Q): "
  151.   EDRO = 23
  152.   EDCO = 18
  153.   EDVAL$= "ERQ"
  154.  
  155.   CFRO = 23
  156.   CFCO = 20
  157.   CFPRO$ = "E)dit, S)ave, Q)uit (E,S,Q): "
  158.   CFVAL$ = "ESQ"
  159.  
  160.   THREE = 3
  161.   FOUR = 4
  162.   FROW(1) = 7
  163.   FROW(2) = 9
  164.   FROW(3) = 11
  165.   FCOL(1) = 10
  166.   FCOL(2) = 10
  167.   FCOL(3) = 10
  168.   FFLDSIZE(1) = 40
  169.   FFLDSIZE(2) = 40
  170.   FFLDSIZE(3) = 40
  171.   FFLDTYPE$(1) = "S"
  172.   FFLDTYPE$(2) = "S"
  173.   FFLDTYPE$(3) = "S"
  174.  
  175.   FOR I = 1 TO NCNFG
  176.     READ CROW(I),CCOL(I),CPRO$(I),CFLDSIZE(I),CFLDTYPE$(I),CFLDVAL$(I),CHLP$(I)
  177.   NEXT I
  178.  
  179. DATA  01,18,"BATCH LINE EDITOR - CONFIGURATION   Ver 1.3",00,L,   ,
  180. DATA  03,12,"Source EXTENSION:"                  ,03,S,BAS,"Default extension for source file to be edited (e.g. BAS)"
  181. DATA  04,12,"Merge EXTENSION:"                   ,03,S,MRG,"Default extension for file of changes to source (e.g. MRG)"
  182. DATA  05,12,"Source remarks begin with:"         ,03,S,"'","Logically ignore rest of physical line beyond this"
  183. DATA  06,12,"END OF BLOCK Phrase:"               ,20,S,ENDBLOCK,"Phrase used in BLED for the end of a block"
  184. DATA  07,12,"Documentation BEGINS with: "        ,01,S,*  ,"Character that documentation lines begin with in BLED merge file"
  185. DATA  08,12,"Alphanumeric LABELS END with:"      ,01,S,":","Character on end of an alphanumeric label (e.g. ':' in 'GETOUT:')"
  186. DATA  09,12,"BLED COMMANDS BEGIN with:"          ,01,S,   ,"Character starting BLED commands in merge file (default none)"
  187. DATA  10,12,"IGNORE CASE in Labels?"             ,01,S,Y  ,"Lower/upper case are same in labels (e.g. 'LABEL1' and 'label1')"
  188. DATA  11,12,"CONTINUED LINES END with:"          ,01,S,_  ,"Character used to continue logical line onto next line"
  189. DATA  12,12,"Write WARNINGS to:"                 ,30,S,WARNING,"File to write warning messages to"
  190. DATA  13,12,"Max # physical lines btw line #'s:" ,04,N,200,"In file compare, max # physical lines between two line numbers"
  191.  
  192. RETURN
  193.  
  194. REM -------------------------[ GETCONFIG ]---------------------------------
  195.  
  196. GETCONFIG:
  197.  
  198. REM   GETS CONFIGURATION PARAMETERS
  199.  
  200.    ON ERROR GOTO NOCONFIG
  201.    OPEN "I",#1,CONFIGFILE$
  202.  
  203.    READIN:
  204.      ON ERROR GOTO 0
  205.      LINE INPUT #1,DESOURCE$
  206.      LINE INPUT #1,DEMERGES$
  207.      LINE INPUT #1,REMCHAR$
  208.      LINE INPUT #1,ENDBLK$
  209.      LINE INPUT #1,DOCCHAR$
  210.      LINE INPUT #1,END.LABEL$
  211.      LINE INPUT #1,BLEDCMD$
  212.      LINE INPUT #1,IGNORECASE$
  213.      LINE INPUT #1,LINEON$
  214.      LINE INPUT #1,X$
  215.      IF WARNFILE$ = "" THEN WARNFILE$ = X$
  216.      LINE INPUT #1,MAXBTWLINES$
  217.      CLOSE #1
  218.    RETURN
  219.  
  220.    USEDEFAULTS:
  221.      ON ERROR GOTO 0
  222.      DESOURCE$ = "BAS"
  223.      DEMERGES$ = "MRG"
  224.      REMCHAR$  = "'"
  225.      ENDBLK$     = "ENDBLOCK"
  226.      DOCCHAR$    = "*"
  227.      END.LABEL$  = ":"
  228.      BLEDCMD$    = ""
  229.      IGNORECASE$ = "Y"
  230.      LINEON$     = "_"
  231.      IF WARNFILE$ = "" THEN WARNFILE$ = "WARNING"
  232.      MAXBTWLINES$ = "200"
  233.    RETURN
  234.  
  235. NOCONFIG:
  236.    X$ = "Config file "+CONFIGFILE$+" missing/bad.  Using QuickBASIC defaults."
  237.    CALL EXPLAIN(X$)
  238.    RESUME USEDEFAULTS
  239.  
  240. REM -----------------------------------------------------------------------
  241.  
  242. REM *****                MAIN   ROUTINES                       ****
  243. REM **********  SETCONFIG,FILECOMPARE,DOLINEMERGE,DOMERGE      ****
  244.  
  245. REM -----------------------[ SETCONFIG ]-----------------------------------
  246.  
  247. SETCONFIG:
  248.  
  249. REM      ALLOWS USER TO RECONFIGURE
  250.  
  251.    CFLDVAL$(2) = DESOURCE$
  252.    CFLDVAL$(3) = DEMERGES$
  253.    CFLDVAL$(4) = REMCHAR$
  254.    CFLDVAL$(5) = ENDBLK$
  255.    CFLDVAL$(6) = DOCCHAR$
  256.    CFLDVAL$(7) = END.LABEL$
  257.    CFLDVAL$(8) = BLEDCMD$
  258.    CFLDVAL$(9) = IGNORECASE$
  259.    CFLDVAL$(10)= LINEON$
  260.    CFLDVAL$(11)= WARNFILE$
  261.    OLDWARN$    = WARNFILE$
  262.    CFLDVAL$(12)= MAXBTWLINES$
  263.  
  264.    CALL PRTSCRN (NCNFG,CROW(),CCOL(),CPRO$(),CFLDSIZE(),CFLDTYPE$(),_
  265.                  CFLDVAL$(),CHLP$())
  266.    CO=1:CALL QPRINT (SPACE$(79),FRO,CO)
  267.    RESETCNFG:
  268.      ANS$="E"
  269.      CALL GETCHAR(CFRO,CFCO,CFPRO$,CFVAL$,ANS$)
  270.      WHILE ANS$ = "E"
  271.        CALL GETSCRN (NCNFG,CROW(),CCOL(),CPRO$(),CFLDSIZE(),CFLDTYPE$(),_
  272.                  CFLDVAL$(),CHLP$())
  273.        LOCATE CFRO,1:PRINT SPACE$(79)
  274.        ANS$="":CALL GETCHAR (CFRO,CFCO,CFPRO$,CFVAL$,ANS$)
  275.      WEND
  276.  
  277.  DESOURCE$ = CFLDVAL$(2)
  278.  BTCHCMDS$ = CFLDVAL$(3)
  279.  NEWFILE$  = CFLDVAL$(4)
  280.  ENDBLK$   = CFLDVAL$(5)
  281.  DOCCHAR$  = CFLDVAL$(6)
  282.  END.LABEL$ = CFLDVAL$(7)
  283.  BLEDCMD$   = CFLDVAL$(8)
  284.  IGNORECASE$ = CFLDVAL$(9)
  285.  LINEON$     = CFLDVAL$(10)
  286.  WARNFILE$   = CFLDVAL$(11)
  287.  
  288.  IF WARNFILE$ <> OLDWARN$ THEN_
  289.    CLOSE #4:OPEN "O",#4,WARNFILE$
  290.  IF ANS$ = "Q" THEN RETURN  
  291.  IF ANS$ <> "S" THEN RETURN
  292.      OPEN "O",#1,CONFIGFILE$
  293.      FOR I = 1 TO NCNFG
  294.        IF CFLDTYPE$(I) <> "L" THEN PRINT #1,CFLDVAL$(I)
  295.      NEXT I
  296.      CLOSE #1
  297.      GOTO RESETCNFG
  298.  
  299. RETURN
  300.  
  301. REM -----------------------[ FILECOMPARE ]---------------------------------
  302.  
  303. FILECOMPARE:
  304.  
  305. REM     COMPARES TWO FILES, PRODUCES MERGE FILE FOR LINE MERGING
  306.  
  307.   FPROMPT$(1)= "OLD VERSION:"
  308.   FPROMPT$(2)= "NEW VERSION:"
  309.   FPROMPT$(3)= "MERGES (to OLD to make NEW):"
  310.   FHLP$(1)   = "Old version of file that has been changed"
  311.   FHLP$(2)   = "New, modified version of file"
  312.   FHLP$(3)   = "Create file of changes to old version needed to make new version"
  313.   TOPTITLE$ = "COMPARING FILES - Generating Merge"
  314.   GOSUB GETFILES
  315.   IF FANS$ = "Q" THEN RETURN
  316.  
  317.    HEADER$ = DOCCHAR$ + " ------------[ BLED merge (c) Ken Goosens ]-------------"
  318.    CALL WRITENEW (HEADER$,NWRITE)
  319.    HEADER$ = DOCCHAR$ + " Merge this against " + ORIGFILE$ + _
  320.              " to produce " + BTCHCMDS$
  321.    CALL WRITENEW (HEADER$,NWRITE)
  322.    HEADER$ = DOCCHAR$ + "-------------[ Created "+DATE$+" "+TIME$+" ]------------"
  323.    CALL WRITENEW (HEADER$,NWRITE)
  324.  
  325.    TRANS# = 0
  326.    MAST#  = 0
  327.    GOSUB READLINETRANS
  328.    GOSUB READLINEOLD
  329.    WHILE MAST# < HI.VALUE# OR TRANS# < HI.VALUE#
  330.       IF TRANS# < MAST# THEN _
  331.          CALL WRITENEW (INSERTING$,NWRITE) : _
  332.          WHILE TRANS# < MAST#: _
  333.            CALL WRITENEW (NUTRANS$,NWRITE) : _
  334.            GOSUB READLINETRANS : _
  335.          WEND
  336.       IF MAST# < TRANS# THEN _
  337.          CALL WRITENEW (DELETING$,NWRITE) : _
  338.          WHILE MAST# < TRANS# : _
  339.            PREV# = MAST# : _
  340.            FW$ = MID$(STR$(MAST#),2) : _
  341.            CALL WRITENEW (FW$,NWRITE) : _
  342.            WHILE PREV# = MAST# : _
  343.              GOSUB READLINEOLD : _
  344.            WEND: _
  345.          WEND
  346.       IF TRANS# = MAST# AND MAST# < HI.VALUE# THEN_
  347.          PREV# = TRANS#:J=0:_
  348.          WHILE PREV# = TRANS# AND J<UBOUND(TBUF$):_
  349.            J=J+1:TBUF$(J)=NUTRANS$:_
  350.            GOSUB READLINETRANS:_
  351.          WEND:_
  352.          I=0:_
  353.          WHILE PREV# = MAST# AND I<UBOUND(MBUF$):_
  354.            I=I+1:MBUF$(I)=TRANS$:_
  355.            GOSUB READLINEOLD:_
  356.          WEND:_
  357.          GOSUB CHKEXCEED:_
  358.          IF M$<>"" THEN_
  359.            N$="Logical line exceeds maximum physical lines.  Reconfigure":_
  360.            CALL WRMIS (M$,N$)_
  361.          ELSE_
  362.            GOSUB CHKDIF:_
  363.            IF ARE.DIFF THEN_
  364.              CALL WRITENEW (REPLACING$,NWRITE) : _
  365.              FOR I=1 TO K-1:CALL WRITENEW (TBUF$(I),NWRITE):NEXT I :_
  366.              GOSUB WRITEDIF : _
  367.              FOR I=K TO MAX:CALL WRITENEW (TBUF$(I),NWRITE):NEXT I :_
  368.              FOR I=MAX+1 TO MAXMAX:CALL WRITENEW (TBUF$(I),NWRITE):NEXT I
  369.    WEND
  370.    CLOSE #1,#2,#3
  371.  
  372. RETURN
  373.  
  374. WRITEDIF:
  375.  
  376.    IF MAXMAX > 1 THEN _
  377.       CALL WRITENEW (FIRSTDIF$,NWRITE)
  378.  
  379.    RETURN
  380.  
  381. CHKEXCEED:
  382.  
  383.    M$ = ""
  384.    IF I=UBOUND(MBUF$) THEN_
  385.      M$="[File "+ORIGFILE$+"]"_
  386.    ELSE IF J = UBOUND(TBUF$) THEN_
  387.      M$="[File "+BTCHCMDS$+"]"
  388.  
  389. RETURN
  390.  
  391. CHKDIF:
  392.  
  393.  
  394. IF I = J THEN _
  395.   ARE.DIFF = 0 _
  396. ELSE _
  397.   ARE.DIFF = -1
  398. IF I<=J THEN _
  399.    MAX = I _
  400. ELSE _
  401.    MAX = J 
  402. MAXMAX = J
  403. K=0
  404. CHKAG:
  405.   K=K+1:IF K<=MAX THEN IF TBUF$(K)=MBUF$(K) THEN GOTO CHKAG ELSE ARE.DIFF=-1
  406. GETOUTCHKDIF:
  407.  
  408. RETURN
  409.  
  410. REM -----------------------[ DOLINEMERGE ]---------------------------------
  411.  
  412. DOLINEMERGE:
  413.  
  414. REM               MERGES BASED ON LINE NUMBER LABELS
  415.  
  416.   TOPTITLE$ = "MERGING using Line Number Labels"
  417.   GOSUB STANDARDFILES
  418.   IF FANS$ = "Q" THEN RETURN
  419.  
  420.    TRANS# = 0
  421.    MAST#  = 0
  422.    GOSUB READLINETRANS
  423.    GOSUB READLINEOLD
  424.    WHILE TRANS# < HI.VALUE# OR MAST# < HI.VALUE#
  425.       WHILE TRANS# < MAST#
  426.         PREV# = TRANS#
  427.         WHILE PREV# = TRANS#
  428.          IF ONLY.LINENO THEN_
  429.            M$=TRANS$:_
  430.            N$="Line number to be deleted not found.":_
  431.            CALL WRMIS (M$,N$)_
  432.          ELSE_
  433.            CALL WRITENEW (NUTRANS$,NWRITE)
  434.          GOSUB READLINETRANS
  435.         WEND
  436.       WEND
  437.       WHILE MAST# < TRANS#
  438.          PREV# = MAST#
  439.          WHILE PREV# = MAST#
  440.            CALL WRITENEW (TRANS$,NWRITE)
  441.            GOSUB READLINEOLD
  442.          WEND
  443.       WEND
  444.       IF TRANS# = MAST# AND MAST# < HI.VALUE# THEN_
  445.          PREV# = TRANS#:_
  446.          WHILE PREV# = TRANS#:_
  447.            GOSUB CHKWRITE:_
  448.            GOSUB READLINETRANS:_
  449.          WEND:_
  450.          WHILE PREV# = MAST#:_
  451.            GOSUB READLINEOLD:_
  452.          WEND
  453.    WEND
  454.    CLOSE #1,#2,#3
  455.  
  456. RETURN
  457.  
  458. CHKWRITE:
  459.  
  460. IF NOT ONLY.LINENO THEN CALL WRITENEW (NUTRANS$,NWRITE)
  461.  
  462. RETURN
  463.  
  464. READLINEOLD:
  465.  
  466.    IF EOF(1) THEN_
  467.      MAST# = HI.VALUE#_
  468.    ELSE_
  469.      GOSUB READOLDREC:_
  470.      CALL FIRSTWORD (TRANS$,FW$):_
  471.      IF FW$="" THEN PREV.MAST=0:RETURN_
  472.      ELSE_
  473.        CONTINUED.MAST = PREV.MAST:_
  474.        CALL CHKCONT (TRANS$,LINEON$,REMCHAR$,PREV.MAST):_
  475.        IF CONTINUED.MAST=0 THEN_
  476.          CALL NUMERIC (FW$,NATNO):_
  477.          IF NATNO THEN_
  478.            PREV# = MAST#:_
  479.            MAST# = VAL(FW$):_
  480.            IF MAST# <= PREV# THEN_
  481.              N$ = "Source line "+FW$+" occurs after line#"+STR$(PREV#):_
  482.              CALL WRMIS (TRANS$,N$)_
  483.            ELSE_
  484.              LOG.LINES = LOG.LINES + 1 : _
  485.              IF MAX.LL > 0 THEN _
  486.                 IF LOG.LINES > MAX.LL THEN _
  487.                    COLOR 7,0 : _
  488.                    PRINT : _
  489.                    PRINT "              Sample MERGE created from ";MAX.LL;" lines":_
  490.                    END
  491. rem IF (MAST# >= 9000 AND MAST# <= 9600) THEN_
  492. rem   X$="mast-out="+STR$(mast#)+" continued="+STR$(continued.mast)+" curr cont="+STR$(prev.mast)+" numeric="+STR$(natno):_
  493. rem    Y$="":CALL WRMIS (X$,Y$)
  494. RETURN
  495.  
  496. READLINETRANS:
  497.  
  498.     ONLY.LINENO = 0
  499.     IF EOF(2) THEN_
  500.       TRANS# = HI.VALUE#_
  501.     ELSE_
  502.       CALL GETTRANS (NUTRANS$,NTRANS):_
  503.       CALL FIRSTWORD (NUTRANS$,FW$):_
  504.       IF FW$="" THEN PREV.CONT=0:RETURN_
  505.       ELSE IF LEFT$(FW$,1)=DOCCHAR$ THEN GOTO READLINETRANS_
  506.              ELSE CONTINUED.LINE = PREV.CONT:_
  507.                   CALL CHKCONT (NUTRANS$,LINEON$,REMCHAR$,PREV.CONT):_
  508.                   IF CONTINUED.LINE=0 THEN_
  509.                     CALL NUMERIC (FW$,NATNO):_
  510.                     IF NATNO THEN_
  511.                       PREV# = TRANS#:_
  512.                       TRANS# = VAL(FW$):_
  513.                       IF TRANS# <= PREV# THEN_
  514.                         N$ = "Merge line# "+FW$+" occurs after line#"+STR$(PREV#):_
  515.                         CALL WRMIS (NUTRANS$,N$)_
  516.                       ELSE_
  517.                         X$ = NUTRANS$:_
  518.                         CALL TRIM (X$):_
  519.                         IF X$ = FW$ THEN ONLY.LINENO = -1
  520. RETURN
  521.  
  522. REM -----------------------[ DOMERGE ]-------------------------------------
  523.  
  524. DOMERGE:
  525.  
  526. REM        GENERAL BLED MERGE BASED ON BLOCK and BLOCK DISPOSITION
  527.  
  528.   TOPTITLE$ = "MERGING - General BLED"
  529.   GOSUB STANDARDFILES
  530.   IF FANS$ = "Q" THEN RETURN
  531.   
  532.   CALL GETNXTCMD (CMD$,DOCCHAR$,STBLKTYPE$,ENDBLKTYPE$,STDES.NO%,ENDDES.NO%,_
  533.                  STTARGET$,ENDTARGET$,INCREMENT%,PTR%,CMD.TYPE$,_
  534.                  INS.BLKTYPE$,FIXED.NO%,BLK.DISP$)
  535.   
  536.   WHILE CMD.TYPE$ <> ""
  537. REM     PRINT "domerge: CMD$=";CMD$;" TYPE=";CMD.TYPE$;" INS BLKTYPE=";INS.BLKTYPE$
  538.      IF CMD.TYPE$ = "I" THEN_
  539.         IF INS.BLKTYPE$ = "L" THEN_
  540.             GOSUB WRNTIMES_
  541.         ELSE_
  542.             GOSUB WRTBLOCK_
  543.      ELSE_
  544.         LINE.DISP$ = "K":_
  545.         PTR.INCREMENT% = 1:_
  546.         TARGET$ = STTARGET$:_
  547.         BLOCK.TYPE$ = STBLKTYPE$:_
  548.         DESIRED.PTR = STDES.NO%:_
  549.         GOSUB ADVANCE:_
  550.         LINE.DISP$ = BLK.DISP$:_
  551.         BLOCK.TYPE$ = ENDBLKTYPE$:_
  552.         DESIRED.PTR = ENDDES.NO%:_
  553.         TARGET$ = ENDTARGET$:_
  554.         PTR.INCREMENT% = INCREMENT%:_
  555.         GOSUB ADVANCE
  556.      CALL GETNXTCMD (CMD$,DOCCHAR$,STBLKTYPE$,ENDBLKTYPE$,STDES.NO%,ENDDES.NO%,_
  557.                  STTARGET$,ENDTARGET$,INCREMENT%,PTR%,CMD.TYPE$,_
  558.                  INS.BLKTYPE$,FIXED.NO%,BLK.DISP$)
  559.  
  560.   WEND
  561.   CLOSE #1,#2,#3
  562.   
  563. RETURN
  564.  
  565. ADVANCE:
  566.       REM DECIDES HOW TO ADVANCE THROUGH OLD FILE
  567.       REM PASS BLOCK.TYPE$
  568.  
  569.       IF BLOCK.TYPE$ = "L" THEN_
  570.           GOSUB READTOLINE_
  571.       ELSE IF BLOCK.TYPE$ = "S" THEN_
  572.           GOSUB READTOSTRING_
  573.       ELSE IF BLOCK.TYPE$ = "LABEL" OR BLOCK.TYPE$="LABEL#" THEN_
  574.           GOSUB READTOLABEL_
  575.       ELSE_
  576.           M$="WARNING: ILLEGAL BLOCK TYPE ":_
  577.           W$=BLOCK.TYPE$:_
  578.           CALL WRMIS (M$,W$)
  579. RETURN
  580.          
  581. READTOLINE:
  582.  
  583.    REM READS UPTO LINE DESIRED.PTR IN OLD
  584.  
  585.    WHILE PTR% < DESIRED.PTR AND NOT EOF(1)
  586.       GOSUB READOLD
  587.       PTR% = PTR% + PTR.INCREMENT%
  588.       IF LINE.DISP$ = "K" THEN CALL WRITENEW (TRANS$,NWRITE)
  589.    WEND
  590. RETURN
  591.  
  592. READTOSTRING:
  593.  
  594.    REM READS UPTO A STRING IN OLD
  595.  
  596.    TRANS$ = TARGET$
  597.    IF NOT EOF(1) THEN GOSUB READOLD
  598.    WHILE INSTR(TRANS$,TARGET$) = 0
  599.       PTR% = PTR% + 1
  600.       IF LINE.DISP$ = "K" THEN CALL WRITENEW (TRANS$,NWRITE)
  601.       IF NOT EOF(1) THEN_
  602.          GOSUB READOLD_
  603.       ELSE_
  604.          M$ = "WARNING: STRING "+TARGET$+" NOT FOUND":_
  605.          W$ = "":_
  606.          CALL WRMIS (M$,W$):_
  607.          TRANS$ = TARGET$
  608.    WEND
  609.    PREV.OLD$ = TRANS$
  610.  
  611. RETURN
  612.  
  613. READTOLABEL:
  614.  
  615.    REM READS UPTO A LABEL IN OLD
  616.  
  617.    IF IGNORECASE THEN CALL UPCASE (TARGET$)
  618.    IF BLOCK.TYPE$ = "LABEL" AND RIGHT$(TARGET$,1) <> END.LABEL$ THEN_
  619.       TARGET$ = TARGET$ + END.LABEL$
  620.    IF NOT EOF(1) THEN_
  621.       GOSUB READOLD:_
  622.       GOSUB GETFIRSTWORD_
  623.    ELSE_
  624.       FIRST.WORD$ = TARGET$:_
  625.       TRANS$ = ""
  626.    WHILE FIRST.WORD$ <> TARGET$
  627.       PTR% = PTR% + 1
  628.       IF LINE.DISP$ = "K" THEN CALL WRITENEW (TRANS$,NWRITE)
  629.       IF NOT EOF(1) THEN_
  630.          GOSUB READOLD:_
  631.          GOSUB GETFIRSTWORD_
  632.       ELSE_
  633.          M$ = "WARNING: LABEL "+TARGET$+" NOT FOUND":_
  634.          W$ = "":_
  635.          CALL WRMIS (M$,W$):_
  636.          FIRST.WORD$ = TARGET$
  637.    WEND
  638.    PREV.OLD$ = TRANS$
  639.  
  640. RETURN
  641.  
  642. GETFIRSTWORD:
  643.  
  644.    CALL FIRSTWORD (TRANS$,FIRST.WORD$)
  645.    IF IGNORECASE THEN CALL UPCASE (FIRST.WORD$)
  646.  
  647. RETURN
  648.  
  649. READOLD:
  650.  
  651.    REM FETCHES NEXT UNPROCESSED RECORD FROM OLD
  652.  
  653.    IF PTR% <= NREAD THEN_
  654.       TRANS$ = PREV.OLD$_
  655.    ELSE_
  656.       GOSUB READOLDREC
  657.  
  658. RETURN
  659.  
  660. READOLDREC:
  661.  
  662.    LINE INPUT #1,TRANS$
  663.    NREAD = NREAD+1
  664.    LOCATE MROW,MCOL:PRINT NREAD;
  665.  
  666. RETURN
  667.  
  668. WRNTIMES:
  669.    REM WRITES EXACTLY N RECORDS FROM TRANSACTION FILE
  670.  
  671.    WHILE FIXED.NO% > 0 AND NOT EOF(2)
  672.       GOSUB READTRANS
  673.       FIXED.NO% = FIXED.NO% - 1
  674.       CALL WRITENEW (NUTRANS$,NWRITE)
  675.    WEND
  676. RETURN
  677.  
  678. READTRANS:
  679.  
  680.    REM FETCHES NEXT DATA (NON-COMMAND) RECORD FROM TRANSACTION FILE
  681.    REM NOTE: WILL NOT SKIP OVER ANY LINES
  682.  
  683.    CALL GETTRANS (NUTRANS$,NTRANS)
  684.    CALL FIRSTNB (NUTRANS$,ONE,BS):IF BS<1 THEN BS=1
  685.    LSET TRANSBLK$ = MID$(NUTRANS$,BS,LBLK)
  686. REM   print "RT BS=";BS;" trans=";trans$;" transblk=<";transblk$;"> endblk=<";endblk$;">"
  687.  
  688. RETURN
  689.  
  690. WRTBLOCK:
  691.  
  692.    REM INSERT ROUTINE WHEN BLOCK
  693.  
  694.    IF NOT EOF(2) THEN GOSUB READTRANS
  695.    WHILE TRANSBLK$ <> ENDBLK$ AND NOT EOF(2)
  696.       CALL WRITENEW (NUTRANS$,NWRITE)
  697.       GOSUB READTRANS
  698.    WEND
  699.  
  700. RETURN
  701.  
  702. REM --------------------[ SHARED ROUTINES ]-----------------------------
  703.  
  704. GETFILES:
  705.  
  706. REM PROMPTS FOR 3 FILE NAMES NEEDED
  707.  
  708.    GOSUB CHKEXTENSIONS
  709.    FFLDVAL$(1) = ORIGFILE$
  710.    FFLDVAL$(2) = BTCHCMDS$
  711.    FFLDVAL$(3) = NEWFILE$
  712.    CALL PRTSCRN (THREE,FROW(),FCOL(),FPROMPT$(),FFLDSIZE(),FFLDTYPE$(),_
  713.                  FFLDVAL$(),FHLP$())
  714.    CALL CENTERBEG (TOPTITLE$,SEVENTYTWO,BEG)
  715.    CALL QPRINT (TOPTITLE$,FOUR,BEG)
  716.    IF RUN.BATCH THEN FANS$="R":GOTO GOTFILES
  717.  
  718.      CO=1:CALL QPRINT (SPACE$(79),FRO,CO)
  719.      FANS$="E"
  720.      CALL GETCHAR(EDRO,EDCO,EDPRO$,EDVAL$,FANS$)
  721.      WHILE FANS$ = "E"
  722.        CALL GETSCRN (THREE,FROW(),FCOL(),FPROMPT$(),FFLDSIZE(),FFLDTYPE$(),_
  723.                FFLDVAL$(),FHLP$())
  724.        LOCATE EDRO,1:PRINT SPACE$(79)
  725.        FANS$="":CALL GETCHAR (EDRO,EDCO,EDPRO$,EDVAL$,FANS$)
  726.      WEND
  727.  
  728.    GOTFILES:  
  729.    IF FANS$<>"Q" THEN_
  730.      GOSUB PREPARECOUNTS:_
  731.      ORIGFILE$ = FFLDVAL$(1):_
  732.      BTCHCMDS$ = FFLDVAL$(2):_
  733.      NEWFILE$  = FFLDVAL$(3):_
  734.      GOSUB OPENFILES:_
  735.      PRINT #4,"--[USING FILES ";ORIGFILE$;" ";BTCHCMDS$;" ";NEWFILE$;"]--"
  736.  
  737. RETURN
  738.  
  739. CHKEXTENSIONS:
  740.  
  741.    IF INSTR(ORIGFILE$,".")=0 THEN ORIGFILE$=ORIGFILE$+"."+DESOURCE$
  742.    IF INSTR(BTCHCMDS$,".")=0 THEN_
  743.      IF FILE.COMPARE THEN_
  744.        BTCHCMDS$=BTCHCMDS$+"."+DESOURCE$_
  745.      ELSE_
  746.        BTCHCMDS$=BTCHCMDS$+"."+DEMERGES$
  747.    IF INSTR(NEWFILE$,".")=0 THEN_
  748.      IF FILE.COMPARE THEN_
  749.        NEWFILE$=NEWFILE$+"."+DEMERGES$_
  750.      ELSE_
  751.        NEWFILE$=NEWFILE$+"."+DESOURCE$
  752.  
  753. RETURN
  754.  
  755. PREPARECOUNTS:
  756.  
  757.   COLOR 0,7
  758.   LOCATE 24,1
  759.   PRINT SPACE$(79);
  760.   LOCATE 24,04:PRINT "SOURCE:";
  761.   LOCATE 24,23:PRINT "CHANGES:";
  762.   LOCATE 24,42:PRINT "NEW:";
  763.   LOCATE 24,60:PRINT "WARNINGS:";
  764.  
  765.   TROW = 24
  766.   TCOL = 31
  767.   WROW = 24
  768.   WCOL = 46
  769.   MROW = 24
  770.   MCOL = 11
  771.   WROW = 24
  772.   WCOL = 69
  773.  
  774. RETURN
  775.  
  776. STANDARDFILES:
  777.  
  778.   FHLP$(1) = "Text file to be edited (e.g. source code in TEST.BAS)"
  779.   FHLP$(2) = "Merges (edits, changes) to be applied (e.g. TEST.MRG)"
  780.   FHLP$(3) = "Save changes made in this file (e.g. old + merges -> TESTNEW.BAS)"
  781.   FPROMPT$(1)= "SOURCE FILE:"
  782.   FPROMPT$(2)= " MERGE FILE:"
  783.   FPROMPT$(3)= "   NEW FILE:"
  784.   GOSUB GETFILES
  785.  
  786. RETURN
  787.  
  788. OPENFILES:
  789.  
  790.   ON ERROR GOTO ERROPEN
  791.   FF$ = ORIGFILE$
  792.   OPEN "I",#1,FF$
  793.   FF$ = BTCHCMDS$
  794.   OPEN "I",#2,FF$
  795.   FF$ = NEWFILE$
  796.   OPEN "O",#3,FF$
  797.   ON ERROR GOTO 0
  798.  
  799.   NREAD = 0
  800.   NWRITE = 0
  801.   NTRANS = 0
  802.   PTR% = 1
  803.  
  804. RETURN
  805.  
  806. ERROPEN:
  807.    X$ = "Error"+STR$(ERR)+" opening file "+FF$
  808.    CALL EXPLAIN(X$)
  809.    FLDSIZ = 30
  810.    RO = 23:CO = 1:CALL QPRINT (SPACE$(79),RO,CO)
  811.    CO=13:PROMPT$ = "Enter file name (<rtn> quits): "
  812.    FFF$ = ""
  813.    CALL GETSTR (RO,CO,PROMPT$,FLDSIZ,FFF$)
  814.    IF FFF$ = "" THEN RESUME QUITMERGE ELSE FF$=FFF$:RESUME
  815. QUITMERGE: FANS$="Q":RETURN
  816.  
  817. REM *****************   SHARED CALLED SUBROUTINES   *****************
  818.  
  819. SUB WRITENEW (NEWOUT$,NWRITE%) STATIC
  820.  
  821. REM WRITES NEWOUT$ TO NEW FILE
  822.  
  823.    DEFINT A-Z
  824.  
  825.    PRINT #3,NEWOUT$
  826.    NWRITE% = NWRITE% + 1
  827.    LOCATE 24,46:PRINT NWRITE;
  828.  
  829. END SUB
  830.  
  831. SUB CHKCONT (STRNG$,LINEON$,REMCHAR$,CONTINUED%) STATIC
  832.  
  833. REM CHECKS WHETHER LINE STRNG$ CONTINUES LOGICALLY TO NEXT LINE
  834.  
  835. DEFINT A-Z
  836. rem IF DEB=0 THEN DEB = INSTR(STRNG$,"9150 IF")
  837. rem IF DEB>0 THEN IF INSTR(STRNG$,"9510 US") THEN DEB = 0
  838. CONTINUED%=0
  839. ONE = 1
  840. BS = 1
  841. LS = LEN(STRNG$)
  842. LCO = INSTR(STRNG$,LINEON$)
  843. IF LCO=0 THEN GOTO GETOUTCHKCONT
  844.   CHKREM:
  845.     X = INSTR(BS,STRNG$,REMCHAR$)
  846.     IF X=0 THEN_
  847.        X$=STRNG$:GOTO ALLSTRNG_
  848.     ELSE_
  849.        CALL FIRSTNB (STRNG$,ONE,XX):_
  850.        IF X=XX THEN GOTO GETOUTCHKCONT
  851.     CALL INQUOTES (STRNG$,X,INQUO)
  852.     IF INQUO>0 THEN BS=INQUO+1:IF BS<=LS THEN GOTO CHKREM
  853.     X$ = LEFT$(STRNG$,X-1)
  854.   ALLSTRNG:
  855.     CALL ENDNB (X$,ES)
  856.     CONTINUED% = (MID$(X$,ES,1) = LINEON$)
  857. REM    IF CONTINUED% <> 0 THEN PRINT "es=";es;" checking char <";MID$(X$,ES,1);">  CONT?=";CONTINUED%
  858. GETOUTCHKCONT:
  859. rem IF DEB>0 THEN_
  860. rem   PRINT "CONT?=";CONTINUED%;" for >";STRNG$;"<":_
  861. rem   PRINT "LCO=";LCO;" REM POS =";X;" INQUO=";INQUO;" BS= ";BS;" ES=";ES;:INPUT XX$:PRINT
  862. END SUB
  863.  
  864. SUB INQUOTES (STRNG$,BS%,INQUO%) STATIC
  865.  
  866. REM CHECKS WHETHER CHARACTER AT POSITION BS% IN STRNG$
  867. REM        IS INSIDE A PAIR OF QUOTES.  RETURNS POSITION OF RIGHT QUOTE
  868. REM        IF INSIDE, 0 IF NOT INSIDE
  869.  
  870. DEFINT A-Z
  871. QUOTE$=CHR$(34)
  872. BEG = 1
  873. INQUO% = 0
  874. CHKQAGAIN:
  875.   FQUO = INSTR(BEG,STRNG$,QUOTE$)
  876.   IF FQUO=0 THEN GOTO GETOUTINQUOTES
  877.   IF BS%<=FQUO THEN GOTO GETOUTINQUOTES
  878.   SQUO = INSTR(FQUO+1,STRNG$,QUOTE$)
  879.   IF SQUO=0 THEN GOTO GETOUTINQUOTES
  880.   IF BS% < SQUO THEN_
  881.     INQUO%=SQUO:GOTO GETOUTINQUOTES
  882.   BEG = SQUO+1
  883. GOTO CHKQAGAIN
  884.   
  885. GETOUTINQUOTES:
  886. REM PRINT "INQUOTES: LOOKING AT POS ";BS%;"<";MID$(STRNG$,BS%,1);"> SENDING INQUO=";INQUO%
  887. END SUB
  888.  
  889.